"Module": "Const SRCCOPY = &HCC0020\r\nDim loading%, resizing%\r\nDim twx%, twy%, borderx%, bordery%\r\nType boxsize\r\n\tWidth As Integer\r\n\tHeight As Integer\r\nEnd Type\r\n\r\nType POINTAPI\r\n\tx As Integer\r\n\ty As Integer\r\nEnd Type\r\n\r\nType RECT\r\n\tLeft As Integer\r\n\tTop As Integer\r\n\tright As Integer\r\n\tbottom As Integer\r\nEnd Type\r\n\r\nType TabData\r\n\t'control 'properties' - set by caller\r\n\tnumpages As Integer 'num of Page()'s\r\n\tactive As Integer 'active Page()\r\n\torient As Integer 'up = 0, down = 1\r\n\tcols As Integer 'horz# of tabs\r\n\tTabboxLeft As Long 'control left in twips\r\n\tTabboxTop As Long 'control top in twips\r\n\toffset As Integer 'tab angle\r\n\t'optional 'properties' - set by caller for sizable windows\r\n\tminwidth As Integer 'based on size of captions\r\n\tminheight As Integer 'user-defined\r\n\tctlWidth As Long 'width of whole control\r\n\tctlHeight As Long 'height of whole control\r\n\t'optional properties for 'nonaligned' controls\r\n\tinsetx As Integer\r\n\tinsety As Integer\r\n\t'calculated by DefineControl()\r\n\trows As Integer '# of tabs horiz\r\n\ttabbox As boxsize 'tabbox in pixels\r\n\tinvtab As boxsize 'invbox in pixels\r\nEnd Type\r\n\r\nDeclare Function BitBlt% Lib \"GDI\" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)\r\nDeclare Function GetParent% Lib \"User\" (ByVal hWnd%)\r\nDeclare Sub GetClientRect Lib \"User\" (ByVal hWnd%, lpRect As RECT)\r\nDeclare Sub GetWindowRect Lib \"User\" (ByVal hWnd%, lpRect As RECT)\r\nDeclare Function BitBlt% Lib \"GDI\" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)\r\nDeclare Function GetParent% Lib \"User\" (ByVal hWnd%)\r\nDeclare Sub GetClientRect Lib \"User\" (ByVal hWnd%, lpRect As RECT)\r\nDeclare Sub GetWindowRect Lib \"User\" (ByVal hWnd%, lpRect As RECT)\r\n\r\nSub DefineControl (F As Form, tbox As Control, ibox As Control, page() As Control, tb As TabData)\r\nDim pageleft&, pagetop&, pageheight&, pagewidth&\r\nDim tabtop&, aligned%, w&, h&\r\nDim theight&, pheight&, i%\r\n'\r\nloading = -1\r\n'Debug.Print \"=========new run================\"\r\nzGetScaleData F, tbox, tb\r\n\r\n'note:if any of these values have been set by the caller, then\r\n'the control will be sized to fit them all!\r\n'otherwise the tab and the Form will be fitted to Page(0)\r\nIf tb.TabboxLeft = 0 And tb.TabboxTop = 0 And tb.ctlWidth = 0 And tb.ctlHeight = 0 Then aligned = -1\r\n\r\n'===initialize structure with size of the control======\r\n If tb.cols = 0 Then tb.cols = tb.numpages + 1\r\n If tb.numpages = 0 Then tb.numpages = UBound(page)\r\n If tb.offset = 0 Then tb.offset = 4\r\n If tb.insetx = 0 Then tb.insetx = 8 * twx\r\n If tb.insety = 0 Then tb.insety = 8 * twy\r\n '\r\n tb.rows = tb.numpages \\ tb.cols + 1\r\n\r\n'---set height of invbox & tabbox based on textsize\r\n tb.invtab.Height = (tbox.TextHeight(\"X\") + tb.offset)'pels\r\n tb.tabbox.Height = tb.invtab.Height * tb.rows 'pels\r\n ' add 2 pixels to boxheight for 'focus' lines\r\n theight& = (tb.tabbox.Height + 2) * twx\r\n\r\n'---set an integral pixel width for invbox & tabbox\r\n If aligned Then\r\n pagewidth = page(0).Width \\ twx\r\n tb.invtab.Width = (pagewidth + (2 * tb.insetx \\ twx)) \\ tb.cols\r\n tb.tabbox.Width = tb.invtab.Width * tb.cols\r\n tb.ctlWidth = tb.tabbox.Width * twx\r\n Else\r\n 'for 'nonaligned', use tbox.width by default\r\n If tb.ctlWidth = 0 Then\r\n\ttb.invtab.Width = (tbox.Width \\ tb.cols) \\ twx\r\n\ttb.ctlWidth = tbox.Width\r\n Else\r\n 'adjust the value set by the user\r\n\ttb.invtab.Width = (tb.ctlWidth \\ tb.cols) \\ twx\r\n End If\r\n tb.tabbox.Width = tb.invtab.Width * tb.cols\r\n pagewidth = tb.tabbox.Width - 2 * tb.insetx \\ twx\r\n End If\r\n\r\n'--- Calculate size of Page() height & inset---------------\r\n If aligned Then\r\n 'use page(0) to set control and form height\r\n pageheight = page(0).Height \\ twy\r\n tb.insetx = (tb.ctlWidth - page(0).Width) \\ 2\r\n pheight& = page(0).Height + 2 * tb.insety\r\n Else\r\n If tb.ctlHeight = 0 Then\r\n\t'if it wasn't specified, there's no way\r\n\t'to set it\r\n\tMsgBox \"Must specify a control height: tb.ctlHeight = (some value)\"\r\n Else\r\n pageheight = (tb.ctlHeight - theight&) \\ twy - 2 * tb.insety \\ twy\r\n 'pheight& = pageheight * twy + 2 * tb.insety\r\n pheight& = (tb.ctlHeight - theight)\r\n End If\r\n End If\r\n\r\n'----height of entire control-----\r\n If aligned Then tb.ctlHeight = theight& + pheight&\r\n\r\n'all fields should now be initialized (except minwidth)\r\n\r\n'===position it all according to the align paramater=======\r\npageleft = tb.TabboxLeft + tb.insetx\r\nIf tb.orient Then 'tabs down\r\n pagetop = tb.TabboxTop + tb.insety\r\n tabtop = tb.TabboxTop + pheight&\r\nElse ' tabs up\r\n pagetop = tb.TabboxTop + tb.insety + theight&\r\n tabtop = tb.TabboxTop\r\nEnd If\r\n'size all the pages to fit Page(0)\r\nFor i = 0 To tb.numpages\r\n page(i).Move pageleft, pagetop, pagewidth * twx, pageheight * twy\r\nNext\r\n'size the tabbox to fit the pages\r\ntbox.Move tb.TabboxLeft, tabtop, tb.ctlWidth, theight&\r\n\r\n'Draw the constant elements-----\r\nDrawTabs ibox, tbox, tb\r\n\r\n'now resize the form\r\nw = tb.ctlWidth + borderx\r\nh = tb.ctlHeight + bordery\r\nIf twx = 1 Then\r\n w = w * screen.TwipsPerPixelX\r\n h = h * screen.TwipsPerPixelY\r\nEnd If\r\nIf aligned Then\r\n F.Move F.Left, F.Top, tb.ctlWidth + borderx, tb.ctlHeight + bordery\r\nEnd If\r\npage(tb.active).ZOrder\r\nEnd Sub\r\n\r\nSub DrawTabs (ibox As Control, tbox As Control, tb As TabData)\r\nDebug.Print \"Entering DrawTabs------------\"\r\n'called by DefineControl\r\n'called by TabResize for sizable windows\r\nDim n% 'line color (shadow/hilite)\r\nDim box As RECT\r\nDim yoff%, xoff% 'inset for angled line\r\nDim top2% 'hilite/shadow line\r\nDim invert% '+/- multiplier\r\nDim x%, y%, res%\r\nDim n1%, n2%\r\n\r\nibox.Cls\r\nibox.Move 0, 0, tb.invtab.Width, tb.invtab.Height\r\n'set color and scale\r\nbox.Left = 0: box.right = ibox.ScaleWidth - 1\r\nxoff = 4\r\nIf tb.orient Then 'tabs down\r\n n = 8 'darkgrey\r\n box.bottom = -1\r\n box.Top = ibox.ScaleHeight - 1\r\n top2 = box.Top - 1\r\n yoff = box.Top - 4\r\n invert = -1\r\nElse\r\n n = 15 'white\r\n box.Top = 0: box.bottom = ibox.ScaleHeight\r\n top2 = 1\r\n yoff = 4\r\n invert = 1\r\nEnd If\r\n\r\n' Draw black lines\r\nibox.Line (box.Left, yoff)-(xoff, box.Top) 'angle\r\nibox.Line -(box.right - xoff - 1, box.Top) 'box.top\r\nibox.Line (box.right - xoff - 1, box.Top)-(box.right, yoff + 1 * invert) 'angle\r\nibox.Line (box.right, box.Top)-(box.right, box.bottom) 'box.right\r\n' Draw white/grey lines\r\nibox.Line (box.Left, box.bottom)-(box.Left, yoff + 1 * invert), QBColor(15) 'box.left\r\nibox.Line -(xoff, top2), QBColor(15) 'angle\r\nibox.Line -(box.right - xoff - 1, top2), QBColor(n) 'top\r\nibox.Line -(box.right - 1, yoff + 1 * invert), QBColor(8) 'angle\r\nibox.Line -(box.right - 1, box.bottom), QBColor(8) 'right\r\nibox.Line (box.Left, box.Top)-(box.Left, yoff), QBColor(15)\r\nibox.Line (box.right, box.Top)-(box.right, yoff)\r\nibox.Line (box.right - 1, box.Top)-(box.right - 1, yoff), QBColor(8)\r\n\r\n'blit to all the lower rows\r\ntbox.Visible = 0\r\ntbox.AutoRedraw = -1\r\nIf tb.rows > 1 Then\r\n If tb.orient Then\r\n n1 = 0: n2 = tb.rows - 2\r\n Else\r\n n1 = 1: n2 = tb.rows - 1\r\n End If\r\n For y = n1 To n2\r\n For x = 0 To tb.cols - 1\r\n If tb.orient Then\r\n res = BitBlt(tbox.hDC, x * tb.invtab.Width, y * tb.invtab.Height + 2, tb.invtab.Width, tb.invtab.Height + 2, ibox.hDC, 0, 0, SRCCOPY)\r\n Else\r\n res = BitBlt(tbox.hDC, x * tb.invtab.Width, y * tb.invtab.Height, tb.invtab.Width, tb.invtab.Height, ibox.hDC, 0, 0, SRCCOPY)\r\n End If\r\n Next: Next\r\nEnd If\r\n\r\n'add some grey for the background\r\nibox.Line (0, box.Top)-(0, yoff), QBColor(8)\r\nibox.Line (1, box.Top)-(1, yoff - 1 * invert), QBColor(8)\r\nibox.Line (2, box.Top)-(2, yoff - 2 * invert), QBColor(8)\r\nibox.Line (box.right, box.Top)-(box.right, yoff + 1 * invert), QBColor(8)\r\nibox.Line (box.right - 1, box.Top)-(box.right - 1, yoff), QBColor(8)\r\nibox.Line (box.right - 2, box.Top)-(box.right - 2, yoff - 1 * invert), QBColor(8)\r\nibox.Line (box.right - 3, box.Top)-(box.right - 3, yoff - 2 * invert), QBColor(8)\r\nibox.PSet (3, box.Top), QBColor(8)\r\nibox.PSet (box.right - 4, box.Top), QBColor(8)\r\n'now blit the top row\r\nIf tb.orient Then\r\n y = tb.rows - 1\r\nElse\r\n y = 0\r\nEnd If\r\nFor x = 0 To tb.cols - 1\r\n If tb.orient Then\r\n res = BitBlt(tbox.hDC, x * tb.invtab.Width, y * tb.invtab.Height + 2, tb.invtab.Width, tb.invtab.Height + 2, ibox.hDC, 0, 0, SRCCOPY)\r\n Else\r\n res = BitBlt(tbox.hDC, x * tb.invtab.Width, y * tb.invtab.Height, tb.invtab.Width, tb.invtab.Height, ibox.hDC, 0, 0, SRCCOPY)\r\n End If'blit\r\nNext\r\ntbox.Visible = -1\r\ntbox.AutoRedraw = 0\r\n\r\nEnd Sub\r\n\r\nSub DrawText (tbox As Control, page() As Control, tb As TabData)\r\n'called by tbox_paint\r\n'draws tab captions and focus line\r\nDim activerow%\r\nDim txtw%, y1%, y2%\r\nDim x&, y&, inner%, outer%, theight%, cell%\r\n'\r\nDebug.Print \"Entering DrawText---------\"\r\nIf resizing Then Debug.Print \"aborting\": Exit Sub\r\n'\r\ntbox.Cls\r\n\r\n'get row containing active tab\r\n'this row will be drawn on bottom 'values : 0,1,2....\r\nactiverow = tb.active \\ tb.cols\r\n\r\n'get first tab in active row\r\ncell = activerow * tb.cols\r\n\r\n'set y pos\r\nIf tb.orient Then 'tabsdown\r\n inner = 0: outer = (tb.rows - 1) * tb.invtab.Height\r\n theight = tb.invtab.Height\r\nElse 'tabsup\r\n inner = tb.tabbox.Height - tb.invtab.Height: outer = 0\r\n theight = -tb.invtab.Height\r\nEnd If\r\n\r\n'set x pos\r\nFor y = inner To outer Step theight%\r\nFor x = 0 To (tb.cols - 1) * tb.invtab.Width Step tb.invtab.Width\r\n '\r\n If cell > tb.numpages Then\r\n\t'blank tabs\r\n\tcell = 0\r\n\tIf x <> 0 Then Exit For\r\n End If\r\n If cell = tb.active Then tbox.FontBold = -1 Else tbox.FontBold = 0\r\n txtw = tbox.TextWidth(page(cell).Tag)\r\n 'do something here if the caption is too large\r\n 'if txtw >tb.invtab.width then\r\n 'end if\r\n tbox.CurrentX = x + (tb.invtab.Width - txtw) \\ 2\r\n tbox.CurrentY = y + tb.offset \\ 2\r\n tbox.Print page(cell).Tag\r\n cell = cell + 1\r\n 'If n > tb.numpages Then n = 0\r\nNext\r\nNext\r\n\r\n' draw a blank line underneath the selected tab\r\nIf tb.orient Then\r\n inner = 8\r\n y2 = 1: y1 = 0\r\nElse\r\n inner = 15\r\n y1 = tbox.ScaleHeight - 1: y2 = tbox.ScaleHeight - 2\r\nEnd If\r\n'solid line\r\ntbox.Line (0, y1)-(tbox.ScaleWidth, y1), QBColor(inner)\r\ntbox.Line (0, y2)-(tbox.ScaleWidth, y2)\r\n'focus line\r\nx = (tb.active Mod tb.cols) * tb.invtab.Width\r\ntbox.Line (x + 1, y1)-(x + tb.invtab.Width - 2, y1), tbox.BackColor\r\ntbox.Line (x + 1, y2)-(x + tb.invtab.Width - 1, y2), tbox.BackColor\r\ntbox.PSet (x, y1), QBColor(15)\r\ntbox.PSet (x, y2), QBColor(15)\r\ntbox.ZOrder 0\r\nEnd Sub\r\n\r\nSub NextPage (tbox As Control, page() As Control, tb As TabData)\r\nDim n%\r\nn% = ((tb.active + 1) Mod (tb.numpages + 1))\r\ntb.active = n\r\npage(n).ZOrder\r\nDrawText tbox, page(), tb\r\nEnd Sub\r\n\r\nSub PrevPage (tbox As Control, page() As Control, tb As TabData)\r\nDim n%\r\nIf tb.active = 0 Then n = tb.numpages Else n = tb.active - 1\r\ntb.active = n\r\npage(n).ZOrder\r\nDrawText tbox, page(), tb\r\nEnd Sub\r\n\r\nSub TabClick (Button%, x As Single, y As Single, tbox As Control, page() As Control, tb As TabData)\r\n'called by tbox_MouseUp\r\nDim hpos%, vpos%\r\nDim activerow%, thisrow%, row%, n%\r\n\r\nactiverow = tb.active \\ tb.cols '0,1,2...\r\n'\r\nhpos = x \\ tb.invtab.Width '=0,1,2...\r\nvpos = y \\ tb.invtab.Height\r\nIf tb.orient = 0 Then\r\n vpos = tb.rows - vpos - 1\r\nEnd If\r\n'\r\nvpos = vpos + activerow\r\nIf vpos >= tb.rows Then\r\n vpos = vpos - (tb.rows)\r\nEnd If\r\nn = (vpos * tb.cols) + hpos\r\n\r\n'blank tabs:\r\nIf n < 0 Or n > tb.numpages Then Exit Sub\r\n\r\ntb.active = n\r\npage(n).ZOrder\r\nDrawText tbox, page(), tb\r\n\r\nEnd Sub\r\n\r\nSub TabResize (F As Form, x%, y%, tbox As Control, ibox As Control, page() As Control, tb As TabData)\r\n'called by form_resize for resizable windows\r\nDim tw%, i% 'tabwidth\r\nDim l%, t%, w%, h%\r\nDim mintabwidth%, minwinheight%\r\nStatic here%, tightening%\r\nDim theight%, pheight%\r\nDim win As RECT, client As RECT\r\n'---ignore resize events during form_load-------\r\nIf loading Then\r\n here = here + 1: If here < 2 Then Exit Sub\r\n If here = 2 Then here = 0: loading = 0: Exit Sub\r\nEnd If\r\n'---exit if resize was triggered by this routine\r\nIf tightening% Then Exit Sub\r\n\r\nresizing = -1: Debug.Print \"Entering TabResize----------\"\r\n\r\n'get width needed to display text\r\n'note: this can be declared static if calculated only\r\n'the first time if tab captions do not change:\r\n'if mintabwidth = 0 then\r\nmintabwidth = zGetMaxTextWidth(tbox, page(), tb)\r\n'end if\r\ntw = mintabwidth * tb.cols\r\n\r\n'if the caller set minwidth then use it\r\nIf tb.minwidth <> 0 Then\r\n If tb.minwidth \\ twx > tw Then\r\n tw = tb.minwidth \\ twx\r\n mintabwidth = tw \\ tb.cols\r\n End If\r\nEnd If\r\n\r\n'get a minheight\r\nminwinheight = tb.invtab.Height + 20 'some arbitrary size\r\nIf tb.minheight <> 0 Then\r\n If tb.minheight \\ twy > minwinheight Then\r\n minwinheight = tb.minheight \\ twy\r\n End If\r\nEnd If\r\n'\r\nGetClientRect F.hWnd, client\r\n'---set an integral width for the control\r\n If client.right < tw Then\r\n tb.invtab.Width = mintabwidth\r\n Else\r\n tb.invtab.Width = client.right \\ tb.cols\r\n End If\r\n tb.tabbox.Width = tb.invtab.Width * tb.cols\r\n 'reset the form size\r\n tb.ctlWidth = tb.tabbox.Width * twx\r\n'---check the new height\r\n If client.bottom < minwinheight Then\r\n tb.ctlHeight = minwinheight * twy\r\n Else\r\n tb.ctlHeight = client.bottom * twy\r\n End If\r\n theight% = tb.tabbox.Height * twx\r\n pheight = tb.ctlHeight - theight%\r\n\r\n'------ready to draw------------------:\r\ntbox.Visible = 0\r\nFor i = 0 To tb.numpages: page(i).Visible = 0: Next\r\n\r\n'---fit the tbox to the window\r\nl = tb.insetx\r\nw = tb.ctlWidth - 2 * tb.insetx\r\nh = pheight - 2 * tb.insety\r\n'\r\nIf tb.orient Then 'tabs down\r\n t = tb.TabboxTop + l\r\n tbox.Move 0, tb.TabboxTop + pheight, tb.ctlWidth, theight\r\nElse ' tabs up\r\n t = tb.TabboxTop + theight + l\r\n tbox.Move tb.TabboxLeft, tb.TabboxTop, tb.ctlWidth, theight\r\nEnd If\r\n' fit the pages to the window\r\nFor i = 0 To tb.numpages: page(i).Move l, t, w, h: Next\r\n'\r\n'this triggers more calls to this routine:\r\nIf F.WindowState = 0 Then\r\n tightening = -1\r\n 'adjust window to integral tabwidth\r\n F.Move F.Left, F.Top, tb.ctlWidth + borderx, tb.ctlHeight + bordery\r\n 'this isn't the proper way to do this!\r\n 'need to find if the menu will wrap and make this\r\n 'adjustment before the above line\r\n 'adjust for wrapped menu items:\r\n GetWindowRect F.hWnd, win\r\n GetClientRect F.hWnd, client\r\n If (win.bottom - win.Top - client.bottom) * twy <> bordery Then\r\n bordery = (win.bottom - win.Top - client.bottom) * twy\r\n F.Move F.Left, F.Top, tb.ctlWidth + borderx, tb.ctlHeight + bordery\r\n End If\r\nEnd If\r\n'\r\nDrawTabs ibox, tbox, tb\r\n'\r\ntightening = 0: resizing = 0\r\nDrawText tbox, page(), tb\r\n'\r\n'finished, show it\r\ntbox.Visible = -1\r\nFor i = 0 To tb.numpages: page(i).Visible = -1: Next\r\n'\r\nEnd Sub\r\n\r\nPrivate Function zGetMaxTextWidth% (tbox As Control, page() As Control, tb As TabData)\r\n'called by TabResize\r\nDim i%, w%, max%\r\nFor i = 0 To tb.numpages\r\nw = tbox.TextWidth(page(i).Tag)\r\nIf w > max Then max = w\r\nNext\r\nzGetMaxTextWidth = max + 2 * tb.offset\r\nEnd Function\r\n\r\nPrivate Sub zGetScaleData (F As Form, tbox As Control, tb As TabData)\r\n'called by DefineControl\r\nDim containerhwnd%, i%\r\nDim win As RECT, client As RECT\r\n'adjustment for scalemode of the form\r\ntwx = screen.TwipsPerPixelX\r\ntwy = screen.TwipsPerPixelY\r\n'\r\ncontainerhwnd% = GetParent(tbox.hWnd)\r\nIf containerhwnd% = F.hWnd Then\r\n If F.ScaleMode = 3 Then twx = 1: twy = 1\r\nElse\r\nFor i = 0 To F.Controls.Count - 1\r\n On Error Resume Next\r\n If F.Controls(i).hWnd = containerhwnd Then\r\n If F.Controls(i).ScaleMode = 3 Then\r\n\tIf Err Then Exit For\r\n\ttwx = 1: twy = 1\r\n End If\r\n Exit For\r\n End If\r\nNext\r\nEnd If\r\n\r\n'subtract client area from window for border sizes\r\nGetWindowRect F.hWnd, win\r\nGetClientRect F.hWnd, client\r\nborderx = (win.right - win.Left - client.right) * twx\r\nbordery = (win.bottom - win.Top - client.bottom) * twy\r\nEnd Sub\r\n\r\n",
"Form": "BINARY_FILE:Dialogs/0_Form",
"FormCode": "Dim page() As control\r\nDim tb As TabData\r\nSub Form_Load ()\r\n\r\n\r\nInitializeTabs\r\n\r\nEnd Sub\r\n\r\n\r\nSub Form_Resize ()\r\nDim i%\r\nIf windowstate <> 1 Then\r\n TabResize Me, -1, -1, tabbox, invbox, page(), tb\r\nEnd If\r\nEnd Sub\r\n\r\n\r\nSub InitializeTabs ()\r\nDim i%, numpages%\r\n\r\nnumpages = 4 'set to highest index (actual pages - 1)\r\n\r\n'create the page controls==============\r\n'for demo purposes I'm just loading the pages by code\r\n'in an app you need to create them with their child controls\r\n'at design time\r\nFor i = 1 To numpages\r\n Load Picbox(i): Picbox(i).Visible = -1\r\nNext\r\nFor i = 0 To numpages: Picbox(i).Tag = \"Page \" & i: Next\r\n\r\n'create an array of pages==============\r\nReDim page(0 To numpages)\r\nFor i = 0 To numpages: Set page(i) = Picbox(i): Next\r\n\r\n'fill in the fields of the struct======\r\ntb.numpages = numpages 'number of tabs\r\ntb.active = 0 'initial focus\r\ntb.cols = 3 'number of tabs in each row\r\ntb.orient = 0 '0 = up, 1 = down\r\n'vb won't always reinitialize these to 0\r\ntb.TabboxLeft = 0\r\ntb.TabboxTop = 0\r\ntb.ctlWidth = 0\r\ntb.ctlHeight = 0\r\n\r\n'create the control\r\nDefineControl Me, tabbox, invbox, page(), tb\r\nEnd Sub\r\n\r\n\r\nSub tabbox_MouseUp (Button As Integer, Shift As Integer, x As Single, y As Single)\r\nTabClick Button, x, y, tabbox, page(), tb\r\n\r\nEnd Sub\r\n\r\n\r\nSub tabbox_Paint ()\r\nDrawText tabbox, page(), tb\r\nEnd Sub\r\n\r\n\r\n"
},
{
"Name": "ChangeIcon",
"Module": "Global Const GWW_HINSTANCE = (-6)\r\nGlobal Const SRCCOPY = &HCC0020\r\nGlobal tx%, ty%\r\nType itemdata\r\n\tcap As String 'description\r\n\tcline As String 'command line\r\n\tdir As String 'working dir\r\n\ticonpath As String '-\r\n\txpos As Integer 'pos in window\r\n\typos As Integer 'pos in window\r\n\ticonindex As Integer '-\r\n\tkey As Integer 'shortcut key\r\n\tmin As Integer 'run minimized\r\nEnd Type\r\n'used to transfer data between windows\r\nGlobal gItem As itemdata\r\nDeclare Function BitBlt% Lib \"GDI\" (ByVal hDestDC%, ByVal x%, ByVal y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&)\r\nDeclare Function DrawIcon% Lib \"User\" (ByVal hDC%, ByVal x%, ByVal y%, ByVal hIcon%)\r\nDeclare Function ExtractIcon% Lib \"shell.dll\" (ByVal hisnt%, ByVal lpszExeName$, ByVal iIcon%)\r\nDeclare Function GetWindowWord% Lib \"User\" (ByVal hWnd%, ByVal nIndex%)\r\n\r\nFunction GetFile (actn%, fndx%, act%) As String\r\n't%=dialog type 'fn%=filterindex 'act%=action\r\nsample1.cd.Filter = \"All Files(*.*)|*.*|Executable Files(*.hlp;*.exe)|*.hlp;*.exe|Graphic Files(*.bmp;*.ico)|*.bmp;*.ico\"\r\nSelect Case actn%\r\nCase 2'cap\r\nsample1.cd.DialogTitle = \"Save a Graphic File\"\r\nCase 4'browse\r\nsample1.cd.DialogTitle = \"Browse\"\r\nEnd Select\r\nsample1.cd.FilterIndex = fndx%\r\nOn Error Resume Next\r\nsample1.cd.Action = act%\r\nGetFile = sample1.cd.Filename\r\nIf Err = 32755 Then GetFile = \"\"\r\nEnd Function\r\n\r\n",
"Form": "BINARY_FILE:Dialogs/1_Form",
"FormCode": "Sub command1_click (Index As Integer)\r\nDim f$\r\nSelect Case Index\r\nCase 0'ok\r\n 'pass changes back to itemprops:\r\n gItem.iconpath = text1\r\n gItem.iconindex = iconindex\r\n GetIcon gItem.iconpath, gItem.iconindex\r\n Hide\r\nCase 1\r\n Hide\r\nCase 2 'browse\r\n f = GetFile(4, 4, 1): If f$ = \"\" Then Exit Sub\r\n text1 = f$\r\n LoadPics f$, 0\r\nEnd Select\r\nEnd Sub\r\n\r\n\r\nFunction ExtractIcons (f As Form, file$)\r\nDim n%, r%, inst%, i%, h%\r\n\r\nh% = f.hWnd\r\ninst% = GetWindowWord(h%, GWW_HINSTANCE)\r\n\r\n'get total icons in file\r\nn% = ExtractIcon(inst%, file$, -1)\r\nIf n < 1 Then\r\nMsgBox \"The file contains no icons.\": Exit Function\r\nEnd If\r\n\r\n'copy each to a bitmap\r\nscreen.MousePointer = 11\r\nf.icns.Width = n * 36\r\nFor i% = 0 To n - 1\r\nGetIcon file$, i%\r\nr = BitBlt(f.icns.hDC, i * 36 + 1, 1, 32, 32, loader.hDC, 0, 0, SRCCOPY)\r\nNext\r\nf.icns.Refresh\r\nExtractIcons = n\r\nscreen.MousePointer = 0\r\nEnd Function\r\n\r\n\r\nSub Form_Load ()\r\n'in case icon size changes with screen resolution:\r\n'note: this hasn't been tested on anything but 1...x7..\r\n Pic1.Move 112, 48, 6 * 36, 36\r\n icns.Move 0, 0, Pic1.Width, 34\r\n hs.Move Pic1.Left, Pic1.Top + Pic1.Height - 1, Pic1.Width\r\n text1.Width = Pic1.Width\r\n'\r\ntext1 = Trim$(gItem.iconpath)\r\nIf text1 = \"\" Then command1_click 2'prompt for file\r\n'\r\nlastvalidfile$ = text1\r\nLoadPics gItem.iconpath, gItem.iconindex\r\nEnd Sub\r\n\r\n\r\nSub Form_Paint ()\r\nRaiseForm Me\r\nEnd Sub\r\n\r\n\r\nSub GetIcon (file$, ndx%)\r\nDim h%, r%, inst%\r\ninst% = GetWindowWord(hWnd, GWW_HINSTANCE)\r\nh% = ExtractIcon(inst%, file$, ndx%)\r\nloader.Cls\r\nIf h% > 1 Then 'has icons\r\n r% = DrawIcon(loader.hDC, 0, 0, h%)\r\nElse\r\n loader = deficon\r\nEnd If\r\nEnd Sub\r\n\r\n\r\nSub hs_Change ()\r\nicns.Left = -hs.Value\r\nEnd Sub\r\n\r\n\r\nSub icns_DblClick ()\r\ncommand1_click 0\r\nEnd Sub\r\n\r\n\r\nSub icns_mousedown (Button As Integer, Shift As Integer, X As Single, Y As Single)\r\n'erase old hilite\r\nicns.Line (iconindex * 36, 0)-(iconindex * 36 + 34, 34), icns.BackColor, B\r\n'get absolute index\r\niconindex = X \\ 36\r\n'draw new hilite\r\nicns.Line (iconindex * 36, 0)-(iconindex * 36 + 34, 34), &H0&, B\r\nEnd Sub\r\n\r\n\r\nSub LoadPics (f$, ndx%)\r\nDim total%\r\n'\r\nIf f = \"\" Then Exit Sub\r\n'check path, then try to load icons\r\nIf FileLen(f$) Then\r\n lastvalidfile$ = f$\r\nElse\r\n MsgBox \"Cannot open file.\"\r\n text1 = lastvalidfile$: Exit Sub\r\nEnd If\r\n\r\n'copy file's icons to icns picbox\r\ntotal% = ExtractIcons(Me, f$)\r\nIf total% = 0 Then Exit Sub\r\n'\r\n'set scroll range\r\nIf total% > 8 Then\r\n hs.Enabled = -1\r\n hs.Max = (total - 8) * 36\r\nElse\r\n hs.Enabled = 0\r\nEnd If\r\n'\r\n'hilite it\r\niconindex = 0\r\nicns_mousedown 0, 0, ndx% * 36 + 3, 0\r\nEnd Sub\r\n\r\n\r\nSub Text1_Change ()\r\ndirty = -1\r\nEnd Sub\r\n\r\n\r\nSub Text1_GotFocus ()\r\ndirty = 0\r\nEnd Sub\r\n\r\n\r\nSub Text1_LostFocus ()\r\nIf dirty% Then\r\n LoadPics CStr(text1), 0\r\nEnd If\r\nEnd Sub\r\n\r\n\r\n"
